home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / TOTMENU.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-08  |  56KB  |  2,056 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10b                            }
  6.  
  7. Unit totMENU;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.           Mar 10, 1991  1.00a   Enabled immediate selection
  13.                                 when no sub menu.
  14.           Apr  4, 1991  1.00b   Modified EZPULL.Done
  15.           Apr 22, 1991  1.00c   corrected '=' topic
  16.           Apr 26, 1991  1.00d   corrected message clearing
  17.           May  3, 1991  1.00e              ""
  18.           May  7, 1991  1.00f   allowed setting of sub-menus XY
  19.           May 23, 1991  1.00g   Added reaction to Mouse method 1
  20.           Jun 24, 1991  1.00h   Cleared Lotus menu when sub called
  21.           Jul 24, 1991  1.00i   Hide non-selectable items from mouse clicks
  22.           Jan 23, 1992  1.00j   Checked active status in hotkey selection
  23.           Oct  2, 1992  1.00k   Corrected menu clearing in LotusMenuOBJ
  24.           Jan  4, 1993  1.10    Corrected Range Check error on Pullmenus
  25.           May  3, 1993  1.10a   Restored menu message when sub-sub removed
  26.           May  9, 1993  1.10b   Allowed for an empty drop-down.
  27.                                 Thanks to Arnold Gordijn!
  28. }
  29.  
  30. INTERFACE
  31.  
  32. uses DOS, CRT,
  33.      totLOOK, totSYS, totINPUT, totFAST, totWIN, totSTR, totIO1, totLINK;
  34.  
  35. CONST
  36.    EscapeID = 65535;
  37.    LeftID   = 65534;
  38.    RightID  = 65533;
  39.    DriftID  = 65532;
  40.  
  41. TYPE
  42. BaseMenuPtr = ^BaseMenuOBJ;         
  43. MenuItemPtr = ^MenuItem;
  44. MenuItem = record
  45.    NextNode: MenuItemPtr;
  46.    TxtPtr: pointer;
  47.    MsgPtr: pointer;
  48.    HK: word;
  49.    ID: word;
  50.    Active: boolean;
  51.    SubMenu:  BaseMenuPtr;
  52. end;
  53.  
  54. pBaseMenuOBJ = ^BaseMenuOBJ;
  55. BaseMenuOBJ = object
  56.    vItemStack: MenuItemPtr;
  57.    vTotalItems: byte;
  58.    vActiveItem: byte;
  59.    vGap: byte;
  60.    vMsgX: byte;
  61.    vMsgY: byte;
  62.    vX: byte;
  63.    vY: byte;
  64.    vWidth: byte;
  65.    vLastKey: word;
  66.    vAllowEsc: boolean;
  67.    vUsedInPull: boolean;
  68.    vPickOff: boolean;
  69.    vSubActive: boolean;
  70.    vMenuHiHot: byte;
  71.    vMenuHiNorm: byte;
  72.    vMenuLoHot: byte;
  73.    vMenuLoNorm: byte;
  74.    vMenuOff: byte;
  75.    vHelpHook:  HelpProc;
  76.    vHelpKey: word;
  77.    vMsgVisible: boolean;
  78.    {methods...}
  79.    constructor Init;
  80.    procedure   AddFullItem(Txt:StrVisible; ID,HK:word; Msg:StrVisible; SubM:BaseMenuPtr);
  81.    procedure   AddItem(Txt:StrVisible);
  82.    procedure   SetTopic(Item:byte; Txt:StrVisible);
  83.    procedure   SetHK(Item:byte; HK:word);
  84.    procedure   SetMessage(Item:byte; Msg:StrVisible);
  85.    procedure   SetID(Item:byte; ID:word);
  86.    procedure   SetStatus(Item:byte; On:boolean);
  87.    procedure   SetSubMenu(Item:byte;SubMenu:BaseMenuPtr);
  88.    procedure   SetGap(G:byte);
  89.    procedure   SetActiveItem(Item:byte);
  90.    procedure   SetMessageXY(X,Y:byte);
  91.    procedure   SetMenuXY(X,Y:byte);
  92.    procedure   SetHelpKey(K:word);
  93.    procedure   SetHelpHook(Proc:HelpProc);
  94.    procedure   SetAllowEsc(On:boolean);
  95.    procedure   SetColors(HiHot,HiNorm,LoHot,LoNorm,Off:byte);
  96.    procedure   TurnPickOff;
  97.    function    GetAllowEsc: boolean;
  98.    function    GetText(Ptr:MenuItemPtr): StrVisible;
  99.    function    GetMessage(Ptr:MenuItemPtr): StrVisible;
  100.    function    GetID(Item:byte):word;
  101.    function    GetActiveItem: byte;
  102.    function    GetTotalItems: byte;
  103.    function    GetPickOff: boolean;
  104.    function    GetSubActive:boolean;
  105.    procedure   DisplayAllItems;
  106.    function    HotkeySelect(K:word): boolean;
  107.    procedure   ChangeActiveItem(New:byte);
  108.    function    FirstActiveItem: byte;
  109.    function    AddPre(Txt:StrVisible;Hi:boolean):StrVisible;
  110.    function    AddSuf(Txt:StrVisible;Hi:boolean):StrVisible;
  111.    function    ItemPtr(Item:byte): MenuItemPtr;
  112.    procedure   DisposeItems;
  113.    procedure   ChangeMessage(Item:byte; Hi:boolean);
  114.    function    LastKey: word;
  115.    function    GetHelpID: word;
  116.    function    ProcessKey(K:word; X,Y:byte):word;                VIRTUAL;
  117.    function    MenuZone(X,Y:byte):boolean;                       VIRTUAL;
  118.    procedure   SetForPull;                                       VIRTUAL;
  119.    function    TargetPick(X,Y:byte): byte;                       VIRTUAL;
  120.    procedure   DisplayItem(Item:byte;Hi,Msg:boolean);            VIRTUAL;
  121.    procedure   Remove;                                           VIRTUAL;
  122.    function    Activate: word;                                   VIRTUAL;
  123.    procedure   DrawEngine(eX,eY:byte);                           VIRTUAL;
  124.    procedure   HelpTask(ID:word);                                VIRTUAL;
  125.    destructor  Done;                                             VIRTUAL;
  126.    end; {BaseMenuOBJ}
  127.  
  128. pWinMenuOBJ = ^WinMenuOBJ;
  129. WinMenuOBJ = object (BaseMenuOBJ)
  130.    vStyle: byte;
  131.    vWinSaved: boolean;
  132.    vMenuBorder: byte;
  133.    vMenuTitle: byte;
  134.    vMenuIcons: byte;
  135.    {methods...}
  136.    constructor Init;
  137.    procedure   SetStyleTitle(St:byte;Tit:StrVisible);
  138.    procedure   Draw;
  139.    procedure   MoveUp;
  140.    procedure   MoveDown;
  141.    procedure   MoveHome;
  142.    procedure   MoveEnd;
  143.    function    MousePressed(X,Y:byte):boolean;
  144.    function    ProcessKey(K:word; X,Y:byte):word;                VIRTUAL;
  145.    function    MenuZone(X,Y:byte):boolean;                       VIRTUAL;
  146.    procedure   SetForPull;                                       VIRTUAL;
  147.    function    TargetPick(X,Y:byte): byte;                       VIRTUAL;
  148.    procedure   DisplayItem(Item:byte;Hi,Msg:boolean);            VIRTUAL;
  149.    procedure   Remove;                                           VIRTUAL;
  150.    function    Activate: word;                                   VIRTUAL;
  151.    procedure   DrawEngine(eX,eY:byte);                           VIRTUAL;
  152.    function    Win: WinPtr;                                      VIRTUAL;
  153.    destructor  Done;                                             VIRTUAL;
  154. end; {WinMenuOBJ}
  155.  
  156. SubMenuPtr = ^MenuOBJ;
  157. pMenuOBJ = ^MenuOBJ;
  158. MenuOBJ = object (WinMenuOBJ)
  159.    vWin: WinPtr;
  160.    {methods...}
  161.    constructor Init;
  162.    function    Win: WinPtr;                                      VIRTUAL;
  163.    destructor  Done;                                             VIRTUAL;
  164. end; {MenuOBJ}
  165.  
  166. pMoveMenuOBJ = ^MoveMenuOBJ;
  167. MoveMenuOBJ = object (WinMenuOBJ)
  168.    vWin: MoveWinPtr;
  169.    {methods...}
  170.    constructor Init;
  171.    function    Win: WinPtr;                                      VIRTUAL;
  172.    destructor  Done;                                             VIRTUAL;
  173. end; {MoveMenuOBJ}
  174.  
  175. pBarMenuOBJ = ^BarMenuOBJ;
  176. BarMenuOBJ = object (BaseMenuOBJ)
  177.    {methods...}
  178.    constructor Init;
  179.    function    GetX(Item:byte): byte;
  180.    procedure   DisplayItem(Item:byte;Hi,Msg:boolean);            VIRTUAL;
  181.    procedure   DrawEngine(eX,eY:byte);                           VIRTUAL;
  182.    destructor  Done;                                             VIRTUAL;
  183. end; {BarMenuOBJ}
  184.  
  185. BarHotKeyPtr = ^BarHotKeyItem;
  186. BarHotKeyItem = record
  187.    HK:word;
  188.    ID:word;
  189.    NextNode: BarHotKeyPtr;
  190. end; {BarHotKeyRecord}
  191.  
  192. pLotusMenuOBJ = ^LotusMenuOBJ;
  193. LotusMenuOBJ = object (BarMenuOBJ)
  194.    vHKStack: BarHotKeyPtr;
  195.    vMenuBarVisible: boolean;
  196.    {methods...}
  197.    constructor Init;
  198.    procedure   Draw;
  199.    procedure   MoveLeft;
  200.    procedure   MoveRight;
  201.    procedure   MoveHome;
  202.    procedure   MoveEnd;
  203.    procedure   SetSpecialKey(HK:word;ID:word);
  204.    function    HotKeyID(HK:word):word;
  205.    function    GetHK(Item:byte):word;
  206.    procedure   DisposeSpecialKeys;
  207.    function    AltHKItem(K:word):word;
  208.    function    MenuKey(K:word; X,Y:byte): boolean;
  209.    function    MousePressed(X,Y:byte;var Choice:word):boolean;
  210.    function    Push(K:word; X,Y:byte): word;
  211.    function    ProcessKey(K:word; X,Y:byte):word;                VIRTUAL;
  212.    function    TargetPick(X,Y:byte): byte;                       VIRTUAL;
  213.    procedure   Remove;                                           VIRTUAL;
  214.    function    Activate: word;                                   VIRTUAL;
  215.    destructor  Done;                                             VIRTUAL;
  216. end; {LotusMenuOBJ}
  217.  
  218. pPullMenuOBJ = ^